home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "FileSystem"
- '--------------------------------------------------------
- '<Purpose> provides support for the local file system
- '--------------------------------------------------------
-
- Option Explicit
-
- '----------------------------------------------------------------
- '<Purpose> returns the appropriate image number for a drive type
- '----------------------------------------------------------------
- Public Function GetDriveImage(DriveLetter As String) As Integer
- Dim LegalDrive As String
-
- LegalDrive = DriveLetter & ":\"
-
- '---- some drives are not supported here
- Select Case GetDriveType(LegalDrive)
- Case DRIVE_CDROM
- GetDriveImage = imgCDRom
- Case DRIVE_FIXED
- GetDriveImage = imgDriveNotShared
- Case DRIVE_REMOTE
- GetDriveImage = imgNetDrive
- Case DRIVE_REMOVABLE
- GetDriveImage = imgFloppyDrive
- Case Else
- GetDriveImage = DRIVE_UNIDENTIFIED
- End Select
-
- End Function
-
- '------------------------------------------------------------
- '<Purpose> removes a recently disconnected network drive
- '------------------------------------------------------------
- Public Sub RemoveNetDrive(ThisExplorer As Form, ParentNode As Node)
- Dim WorkingNode As Node
- Dim i As Integer
- Dim DriveImage As Integer
- Dim NumberChildren As Integer
- Dim DriveLetter As String * 1
-
- NumberChildren = ParentNode.Children
- For i = 1 To NumberChildren
- If (i = 1) Then
- Set WorkingNode = ParentNode.Child
- Else
- Set WorkingNode = WorkingNode.Next
- End If
-
- '---- calculate the drive letter
- DriveLetter = Mid(WorkingNode.Text, 2, 1)
- DriveImage = GetDriveImage(DriveLetter)
-
- '---- see if the drive is unidentified, and remove it
- If (DriveImage = DRIVE_UNIDENTIFIED) Then
- Call ThisExplorer.Tree.Nodes.Remove(WorkingNode.Key)
-
- '---- also remove the extra data
- Call ThisExplorer.Attachments.Remove(WorkingNode.Key)
-
- Exit Sub
- End If
- Next
-
- Set WorkingNode = Nothing
- End Sub
-
- '------------------------------------------------------------
- '<Purpose> populates the ListView with local files
- ' under a directory
- '------------------------------------------------------------
- Public Sub AddLocalFiles(ThisExplorer As Form, ParentNode As Node)
- Dim TheseItems As ListItems
- Dim WorkingItem As ListItem
- Dim FileAttr As Integer
- Dim FileName As String
- Dim FileType As String
- Dim FullPathName As String
- Dim StartingDir As String
-
- ThisExplorer.MousePointer = vbArrowHourglass
-
- On Error GoTo BadItem
-
- '---- cache the ListItems collection
- Set TheseItems = ThisExplorer.List.ListItems
-
- StartingDir = ThisExplorer.Attachments(ParentNode.Key).DrivePath
-
- On Error GoTo Cleanup
- FileName = Dir(StartingDir)
- On Error GoTo BadItem
-
- Do While (FileName <> "")
- If ((FileName <> ".") And (FileName <> "..")) Then
- FullPathName = StartingDir & FileName
-
- FileAttr = GetAttr(FullPathName) ' Get Files Attributes...
- If (FileAttr <> vbDirectory) Then
- '---- add file to ListView
- Set WorkingItem = TheseItems.Add(, FullPathName, FileName, imgLocalFile, imgLocalFile)
- FileType = "File"
- Else
- '---- add directory to ListView
- Set WorkingItem = TheseItems.Add(, FullPathName, FileName, imgFolderClosed, imgFolderClosed)
- FileType = "File Folder"
- End If
-
- '--- add type, size, and modified bits
- WorkingItem.SubItems(1) = Str((FileLen(FullPathName) \ 1024) + 1) & "KB"
- WorkingItem.SubItems(2) = FileType
- WorkingItem.SubItems(3) = Format(FileDateTime(FullPathName), "General Date")
- End If
-
- NextDir:
- '---- dir with no arguments gets next file, or directory
- FileName = Dir
- Loop
-
- Cleanup:
- On Error GoTo 0
- Set TheseItems = Nothing
- Set WorkingItem = Nothing
- ThisExplorer.MousePointer = vbDefault
- Exit Sub
-
- BadItem:
- Resume NextDir
-
- End Sub
-
- '------------------------------------------------------------
- '<Purpose> populates the TreeView with local directories
- ' under a particular drive or directory
- '------------------------------------------------------------
- Public Sub AddLocalDirs(ThisExplorer As Form, ParentNode As Node)
- Dim TheseItems As ListItems
- Dim WorkingItem As ListItem
- Dim WorkingNode As Node
- Dim TheseNodes As Nodes
- Dim FileAttr As Integer
- Dim DirName As String
- Dim FullPathName As String
- Dim NodeKey As String
- Dim StartingDir As String
-
- ThisExplorer.MousePointer = vbArrowHourglass
-
- On Error GoTo BadNode
-
- '---- cache nodes and list items collections
- Set TheseNodes = ThisExplorer.Tree.Nodes
- Set TheseItems = ThisExplorer.List.ListItems
-
- TheseItems.Clear
-
- StartingDir = ThisExplorer.Attachments(ParentNode.Key).DrivePath
-
- '---- get all directories under the starting directory
- DirName = Dir(StartingDir, vbDirectory)
- Do While (DirName <> "")
- '---- ignore current and previous directories
- If ((DirName <> ".") And (DirName <> "..")) Then
- FullPathName = StartingDir & DirName
- FileAttr = GetAttr(FullPathName)
- If (FileAttr = vbDirectory) Then
- NodeKey = ParentNode.Key & "." & DirName
-
- If (Not IsKeyed(TheseNodes, NodeKey)) Then
- '---- add the node to the tree
- Set WorkingNode = TheseNodes.Add(ParentNode, tvwChild, NodeKey, DirName, imgFolderClosed, imgFolderOpen)
-
- '---- also create and add attachment
- Dim ThisAttachment As New Attachment
- ThisAttachment.NodeType = nodLocalDrive
- ThisAttachment.DrivePath = StartingDir & DirName & "\"
- Call ThisExplorer.Attachments.Add(ThisAttachment, NodeKey)
- Set ThisAttachment = Nothing
-
- '---- add searching placeholder
- Call TheseNodes.Add(WorkingNode, tvwChild, WorkingNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
- End If
-
- '---- add directory to ListView; pad with invisible char for sorting purposes
- Set WorkingItem = TheseItems.Add(, NodeKey, Chr(160) & DirName, imgFolderClosed, imgFolderClosed)
- '--- add type, size, and modified bits to item
- 'WorkingItem.SubItems(1) = Str(FileLen(FullPathName) \ 1024) & "KB"
- WorkingItem.SubItems(2) = "File Folder"
- WorkingItem.SubItems(3) = Format(FileDateTime(FullPathName), "General Date")
- End If
- End If
- '---- dir with no arguments gets next file, or directory
- DirName = Dir
- Loop
-
- Cleanup:
- On Error GoTo 0
- Set TheseItems = Nothing
- Set TheseNodes = Nothing
- Set WorkingItem = Nothing
- Set WorkingNode = Nothing
- ThisExplorer.MousePointer = vbDefault
- Exit Sub
-
- BadNode:
- GoTo Cleanup
- End Sub
-
- '------------------------------------------------------------
- '<Purpose> populates the TreeView with local drives
- '------------------------------------------------------------
- Public Sub AddLocalDrives(ThisExplorer As Form, ParentNode As Node)
- Dim DriveImage As Integer
- Dim DriveID As Long
- Dim TheseNodes As Nodes
- Dim WorkingNode As Node
- Dim DriveLetter As String * 1
- Dim NodeKey As String
- Dim ParentKey As String
-
- ThisExplorer.MousePointer = vbArrowHourglass
-
- '---- errors can be generated from duplicate keys; ignore
- On Error Resume Next
-
- '---- cache nodes collection
- Set TheseNodes = ThisExplorer.Tree.Nodes
-
- ParentKey = ParentNode.Key & "."
-
- For DriveID = Asc("A") To Asc("Z")
- DriveLetter = Chr(DriveID)
- NodeKey = ParentKey & DriveLetter
-
- If (Not IsKeyed(TheseNodes, NodeKey)) Then
- DriveImage = GetDriveImage(DriveLetter)
-
- If (Not (DriveImage = DRIVE_UNIDENTIFIED)) Then
- '---- add the node to the tree
- Set WorkingNode = TheseNodes.Add(ParentNode, tvwChild, NodeKey, "(" & DriveLetter & ":" & ")", DriveImage)
-
- '---- also create and add attachment
- Dim ThisAttachment As New Attachment
- ThisAttachment.NodeType = nodLocalDrive
- ThisAttachment.DrivePath = DriveLetter & ":\"
- Call ThisExplorer.Attachments.Add(ThisAttachment, NodeKey)
- Set ThisAttachment = Nothing
-
- '---- add searching placeholder
- Call TheseNodes.Add(WorkingNode, tvwChild, WorkingNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
- End If
- End If
-
- Next DriveID
-
- Cleanup:
- On Error GoTo 0
- Set TheseNodes = Nothing
- Set WorkingNode = Nothing
- ThisExplorer.MousePointer = vbDefault
- End Sub
-
-
-